home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pastutor.EXE / tutor05.pas < prev    next >
Pascal/Delphi Source File  |  1998-04-02  |  5KB  |  183 lines

  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Tutor05;
  9.  
  10. uses Memory, TutConst, Drivers, Objects, Views, Menus, App, MsgBox,
  11.   Editors, StdDlg;
  12.  
  13. type
  14.   TTutorApp = object(TApplication)
  15.     ClipboardWindow: PEditWindow;
  16.     constructor Init;
  17.     procedure DoAboutBox;
  18.     procedure HandleEvent(var Event: TEvent); virtual;
  19.     procedure InitMenuBar; virtual;
  20.     procedure InitStatusLine; virtual;
  21.     procedure NewWindow;
  22.     procedure OpenWindow;
  23.   end;
  24.  
  25. constructor TTutorApp.Init;
  26. var
  27.   R: TRect;
  28. begin
  29.   MaxHeapSize := 8192;
  30.   EditorDialog := StdEditorDialog;
  31.   inherited Init;
  32.   DisableCommands([cmOrderWin, cmStockWin, cmSupplierWin]);
  33.   Desktop^.GetExtent(R);
  34.   ClipboardWindow := New(PEditWindow, Init(R, '', wnNoNumber));
  35.   if ValidView(ClipboardWindow) <> nil then
  36.   begin
  37.     ClipboardWindow^.Hide;
  38.     InsertWindow(ClipboardWindow);
  39.     Clipboard := ClipboardWindow^.Editor;
  40.     Clipboard^.CanUndo := False;
  41.   end;
  42. end;
  43.  
  44. procedure TTutorApp.DoAboutBox;
  45. begin
  46.   MessageBox(#3'Turbo Vision Tutorial Application'#13 +
  47.     #3'Copyright 1992'#13#3'Borland International',
  48.     nil, mfInformation or mfOKButton);
  49. end;
  50.  
  51. procedure TTutorApp.HandleEvent(var Event: TEvent);
  52. var
  53.   R: TRect;
  54. begin
  55.   inherited HandleEvent(Event);
  56.   if Event.What = evCommand then
  57.   begin
  58.     case Event.Command of
  59.       cmClipShow:
  60.         with ClipboardWindow^ do
  61.         begin
  62.           Select;
  63.           Show;
  64.           ClearEvent(Event);
  65.         end;
  66.       cmNew:
  67.         begin
  68.           NewWindow;
  69.           ClearEvent(Event);
  70.         end;
  71.       cmOpen:
  72.         begin
  73.           OpenWindow;
  74.           ClearEvent(Event);
  75.         end;
  76.       cmOptionsVideo:
  77.         begin
  78.           SetScreenMode(ScreenMode xor smFont8x8);
  79.           ClearEvent(Event);
  80.         end;
  81.       cmAbout:
  82.         begin
  83.           DoAboutBox;
  84.           ClearEvent(Event);
  85.         end;
  86.     end;
  87.   end;
  88. end;
  89.  
  90. procedure TTutorApp.InitMenuBar;
  91. var
  92.   R: TRect;
  93. begin
  94.   GetExtent(R);
  95.   R.B.Y := R.A.Y + 1;
  96.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  97.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  98.       StdFileMenuItems(nil)),
  99.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  100.       StdEditMenuItems(
  101.       NewLine(
  102.       NewItem('~S~how clipboard', '', kbNoKey, cmClipShow, hcNoContext,
  103.       nil)))),
  104.     NewSubMenu('~O~rders', hcNoContext, NewMenu(
  105.       NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
  106.       NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
  107.       NewLine(
  108.       NewItem('Next', 'PgDn', kbPgDn, cmOrderNext, hcNoContext,
  109.       NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
  110.       nil)))))),
  111.     NewSubMenu('O~p~tions', hcNoContext, NewMenu(
  112.       NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
  113.       NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
  114.       NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
  115.       nil)))),
  116.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  117.       NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
  118.       NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
  119.       NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
  120.       NewLine(
  121.       StdWindowMenuItems(nil)))))),
  122.     NewSubMenu('~H~elp', hcNoContext, NewMenu(
  123.       NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
  124.       nil)),
  125.     nil))))))
  126.   )));
  127. end;
  128.  
  129. procedure TTutorApp.InitStatusLine;
  130. var
  131.   R: TRect;
  132. begin
  133.   GetExtent(R);
  134.   R.A.Y := R.B.Y - 1;
  135.   New(StatusLine, Init(R,
  136.     NewStatusDef(0, $EFFF,
  137.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  138.       NewStatusKey('~F4~ New', kbF4, cmNew,
  139.       NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
  140.       StdStatusKeys(nil)))),
  141.     NewStatusDef($F000, $FFFF,
  142.       NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
  143.       NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
  144.       StdStatusKeys(nil))), nil))));
  145. end;
  146.  
  147. procedure TTutorApp.NewWindow;
  148. var
  149.   R: TRect;
  150.   TheWindow: PEditWindow;
  151. begin
  152.   R.Assign(0, 0, 60, 20);
  153.   TheWindow := New(PEditWindow, Init(R, '', wnNoNumber));
  154.   InsertWindow(TheWindow);
  155. end;
  156.  
  157. procedure TTutorApp.OpenWindow;
  158. var
  159.   R: TRect;
  160.   FileDialog: PFileDialog;
  161.   TheFile: FNameStr;
  162. const
  163.   FDOptions: Word = fdOKButton or fdOpenButton;
  164. begin
  165.   TheFile := '*.*';
  166.   New(FileDialog, Init(TheFile, 'Open file', '~F~ile name',
  167.     FDOptions, 1));
  168.   if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
  169.   begin
  170.     R.Assign(0, 0, 75, 20);
  171.     InsertWindow(New(PEditWindow, Init(R, TheFile, wnNoNumber)));
  172.   end;
  173. end;
  174.  
  175. var
  176.   TutorApp: TTutorApp;
  177.  
  178. begin
  179.   TutorApp.Init;
  180.   TutorApp.Run;
  181.   TutorApp.Done;
  182. end.
  183.